home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / tps.zip / TPSLIB.PAS < prev   
Pascal/Delphi Source File  |  1992-09-06  |  3KB  |  137 lines
  1. library tpslib;
  2.  {Unit to tile Turbo Pascal for Windows Child windows
  3.   such that windows are tiled above each other rather
  4.   than side by side. This unit sets up a hook into the
  5.   get message filter and intercepts the specified menu
  6.   command replacing it with a message tile message
  7.   to the MDIClient window.
  8.  
  9.   This program does not intercept TPW accelerators.
  10.   Therefore to tile vertically you can still use Shift-f4
  11.  
  12.    (C) N.Waltham August 1992
  13.        Email 100013.3330@Compuserve.Com
  14.  
  15.   }
  16.  
  17. {'Interface' section of library}
  18.  
  19. Uses
  20.  WinProcs,WinTypes,WinCrt,Strings,CLipLib,Win31;
  21.  
  22. function TileInStall(aFile : pChar; aCommand : integer) : integer;export;forward;
  23. function Uninstall : integer;export;forward;
  24.  
  25. exports TileInstall index 1;
  26. exports Uninstall index 2;
  27.  
  28. {Implementation section of library}
  29.  
  30. {Callback function for wh_GetMessage}
  31.  
  32. type
  33.  pMsg = ^tMsg;  
  34.  tCharStr = array [0..128] of char;
  35.  
  36. var
  37.  Command              : integer;   {the command to intercept}
  38.  PrevGetMessage       : tfarProc;  {the previous message handling filter}
  39.  TaskWindow           : hWnd;      {the handle of TPW main window}
  40.  TaskInstance         : integer;   {the instance of TPW}
  41.  progname             : tCharStr;  {the program name}
  42.  
  43.  
  44. {message filter}
  45. function GetMessage(nCode : integer;wParam : word;var Msg : TMsg) : longint; export;
  46.  
  47. begin
  48. GetMessage:=0;
  49. With Msg do
  50.  begin
  51.  If hWnd <> TaskWindow then exit;  {If this message is for another window then exit}
  52.  If message<>wm_command then exit; {If this message is not a menu command then exit}
  53.  If  wParam=Command then {If its our command then replace it}
  54.   begin
  55.   hWNd:=GetWindow(hWnd,gw_child); 
  56.   Message:=wm_MDITile;
  57.   lParam:=0;
  58.   wParam:=MDITile_Horizontal;
  59.   end;
  60.  end; 
  61.  
  62.  
  63. end;
  64.  
  65.  
  66. {Call back function to find handle of TPW main window}
  67. function WndFmInst(H : hWnd; L : Longint) : Boolean; Export;
  68.  
  69. begin
  70.  WndFmInst:=False; {Stop Enumerating}
  71.  If GetWindowWord(H,gww_HInstance)=L then TaskWindow:=H
  72.   else WndFmInst:=True; {continue enumerating}
  73. end;
  74.  
  75.  
  76. procedure ExecuteProgram;
  77.  
  78. var
  79.  paramblk : record
  80.              pbEnvSeg   : Word;
  81.              pbCmdLine  : pChar;
  82.              pbCmdShow  : pointer;
  83.              pbReserved : Longint;
  84.             end;
  85.  CmdShow  : longint;
  86.  progline : tcharstr;
  87.  TheInst  : tFarProc;
  88.  
  89.  
  90. begin
  91. StrCopy(progline,progname);
  92. StrCat(progline,'.EXE');
  93. CmdShow:=MakeLong(2,sw_ShowNormal);
  94. With ParamBlk do
  95.  begin
  96.  pbEnvSeg:=0;
  97.  pbCmdLine:=#0;
  98.  pbCmdShow:=Addr(CmdShow);
  99.  pbReserved:=0;
  100.  end;
  101. TaskInstance:=LoadModule(Progline,@paramblk);
  102.  
  103. If TaskInstance>32 then
  104.  begin
  105.  TheInst:=MakeProcInstance(@WndFmInst,hInstance);
  106.  TaskWindow:=0;
  107.  EnumWindows(TheInst,TaskInstance);
  108.  FreeProcInstance(TheInst);
  109.  end else Halt(255);
  110. end;
  111.  
  112. {Install Hook}
  113.  
  114. function TileInStall;
  115.  
  116. begin
  117.  StrCopy(progname,aFile);
  118.  Command:=aCommand;
  119.  ExecuteProgram;
  120.  PrevGetMessage:=SetWindowsHook(wh_GetMessage,@GetMessage);
  121.  TileInstall:=TaskWindow;
  122. end;
  123.  
  124. {UnInstall Hook}
  125.  
  126. function Uninstall;
  127.  
  128. begin
  129.  UnHookWindowsHook(wh_GetMessage,@GetMessage);
  130. end;
  131.  
  132.  
  133.  
  134. {No Initialization}
  135.  
  136. begin
  137. end.